home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / Finger 1.3.5 / source / My Units / MyPreferences.unit < prev    next >
Encoding:
Text File  |  1992-02-24  |  4.4 KB  |  174 lines  |  [TEXT/PJMM]
  1. unit MyPreferences;
  2.  
  3. { This code is part of the Finger/Fingerd source code, written in THINK Pascal 4 }
  4. { Copyright 1991-1992 Peter N Lewis }
  5. { If you use this code, you must give me credit in your about box and documentation }
  6. { This is part of my generic library of routines }
  7.  
  8. interface
  9.  
  10.     uses
  11.         Folders, PrefsGlobals;
  12.  
  13.     procedure GetPrefsFSSpec (var fs: FSSpec);
  14.     function OpenPrefsFile (fs: FSSpec): integer;
  15.     function MakePrefsFile (fs: FSSpec): integer;
  16.     procedure GetPrefs (var prefs: prefsRecord);
  17.     procedure SetPrefs (var prefs: prefsRecord);
  18.     procedure JustGetPrefs (var prefs: prefsRecord);
  19.     procedure JustSetPrefs (var prefs: prefsRecord);
  20.     function GetPrefsResource (res: resType; id: integer; var h: handle): integer;
  21.     procedure SetPrefsResource (res: resType; id: integer; h: handle);
  22.  
  23. implementation
  24.  
  25.     procedure GetPrefsFSSpec (var fs: FSSpec);
  26.         var
  27.             gv: longInt;
  28.             oe: OSErr;
  29.             pb: HParamBlockRec;
  30.             sysenv: SysEnvRec;
  31.             s: str255;
  32.             dummy: longInt;
  33.     begin
  34.         if (Gestalt(gestaltFindFolderAttr, gv) <> noErr) | (not BTST(gv, gestaltFindFolderPresent)) | (FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, fs.vRefNum, fs.parID) <> NoErr) then begin
  35.             oe := SysEnvirons(1, sysenv);
  36.             with pb do begin
  37.                 fs.vRefNum := sysenv.sysVRefNum;
  38.                 s := 'Preferences';
  39.                 if DirCreate(sysenv.sysVRefNum, 0, s, fs.parID) <> noErr then begin
  40.                     ioNamePtr := @s;
  41.                     ioVRefNum := fs.vRefNum;
  42.                     ioFDirIndex := 0;
  43.                     ioDirID := 0;
  44.                     if (PBGetCatInfo(@pb, false) = noErr) & (BAND(ioFlAttrib, $0010) <> 0) then
  45.                         fs.parID := pb.ioDirID
  46.                     else
  47.                         fs.parID := 0;
  48.                 end;
  49.             end;
  50.         end;
  51.         GetIndString(s, prefsStrhResID, prefsNameStrhIndex);
  52.         fs.name := s;
  53.     end;
  54.  
  55.     function OpenPrefsFile (fs: FSSpec): integer;
  56.     begin
  57.         OpenPrefsFile := HOpenResFile(fs.vRefNum, fs.parID, fs.name, fsRdPerm);
  58.     end;
  59.  
  60.     function MakePrefsFile (fs: FSSpec): integer;
  61.         const
  62.             finderLaunchStrID = -16397;
  63.         var
  64.             oe: OSErr;
  65.             sh: stringHandle;
  66.             s: str255;
  67.             rn: integer;
  68.     begin
  69.         oe := HCreate(fs.vRefNum, fs.parID, fs.name, prefsCreator, prefsType);
  70.         HCreateResFile(fs.vRefNum, fs.parID, fs.name);
  71.         rn := HOpenResFile(fs.vRefNum, fs.parID, fs.name, fsRdWrPerm);
  72.         if rn <> -1 then begin
  73.             sh := stringHandle(Get1Resource('STR ', finderLaunchStrID));
  74.             if sh = nil then begin
  75.                 GetIndString(s, prefsStrhResID, prefsFinderCommentStrhIndex);
  76.                 sh := NewString(s);
  77.                 if sh <> nil then
  78.                     AddResource(handle(sh), 'STR ', finderLaunchStrID, 'Finder launch string');
  79.             end;
  80.         end;
  81.         MakePrefsFile := rn;
  82.     end;
  83.  
  84.     type
  85.         prefsPtr = ^prefsRecord;
  86.         prefsHandle = ^prefsPtr;
  87.  
  88.     procedure GetPrefs (var prefs: prefsRecord);
  89.         var
  90.             h: handle;
  91.     begin
  92.         h := GetResource(prefsResType, prefsResID);
  93.         prefs.version := -1;
  94.         if (h <> nil) & (GetHandleSize(h) = SizeOf(prefsRecord)) then
  95.             prefs := prefsHandle(h)^^;
  96.         ValidatePrefs(prefs);
  97.     end;
  98.  
  99.     procedure SetPrefs (var prefs: prefsRecord);
  100.         var
  101.             h: handle;
  102.             i: integer;
  103.     begin
  104.         h := Get1Resource(prefsResType, prefsResID);
  105.         if h = nil then begin
  106.             h := NewHandle(SizeOf(prefsRecord));
  107.             if h <> nil then
  108.                 AddResource(h, prefsResType, prefsResID, 'Prefs');
  109.         end;
  110.         if h <> nil then begin
  111.             SetHandleSize(h, SizeOf(prefsRecord));
  112.             prefsHandle(h)^^ := prefs;
  113.             ChangedResource(h);
  114.         end;
  115.     end;
  116.  
  117.     procedure JustGetPrefs (var prefs: prefsRecord);
  118.         var
  119.             prefs_fs: FSSpec;
  120.             prefs_rn: integer;
  121.     begin
  122.         GetPrefsFSSpec(prefs_fs);
  123.         prefs_rn := OpenPrefsFile(prefs_fs);
  124.         GetPrefs(prefs);
  125.         if prefs_rn <> -1 then
  126.             CloseResFile(prefs_rn);
  127.     end;
  128.  
  129.     procedure JustSetPrefs (var prefs: prefsRecord);
  130.         var
  131.             prefs_fs: FSSpec;
  132.             prefs_rn: integer;
  133.     begin
  134.         GetPrefsFSSpec(prefs_fs);
  135.         prefs_rn := MakePrefsFile(prefs_fs);
  136.         if prefs_rn <> -1 then begin
  137.             SetPrefs(prefs);
  138.             CloseResFile(prefs_rn);
  139.         end;
  140.     end;
  141.  
  142.     function GetPrefsResource (res: resType; id: integer; var h: handle): integer;
  143.         var
  144.             prefs_fs: FSSpec;
  145.             prefs_rn: integer;
  146.     begin
  147.         GetPrefsFSSpec(prefs_fs);
  148.         prefs_rn := OpenPrefsFile(prefs_fs);
  149.         h := GetResource(res, id);
  150.         GetPrefsResource := prefs_rn;
  151.     end;
  152.  
  153.     procedure SetPrefsResource (res: resType; id: integer; h: handle);
  154.         var
  155.             prefs_fs: FSSpec;
  156.             prefs_rn: integer;
  157.             h2: handle;
  158.     begin
  159.         if h <> nil then begin
  160.             GetPrefsFSSpec(prefs_fs);
  161.             prefs_rn := MakePrefsFile(prefs_fs);
  162.             if prefs_rn <> -1 then begin
  163.                 h2 := Get1Resource(res, id);
  164.                 if h2 <> nil then begin
  165.                     RmveResource(h2);
  166.                     DisposHandle(h2);
  167.                 end;
  168.                 AddResource(h, res, id, '');
  169.                 CloseResFile(prefs_rn);
  170.             end;
  171.         end;
  172.     end;
  173.  
  174. end.